Visitors and Residents of San Francisco are familiar with the hilly terrain and roads that climb into the clouds. But does this topography have an effect on the likelihood of car break-ins? This regression analysis seeks to provide insights into this question.

That is one steep street!
My research question is: "What is the relationship between topography and car break-ins in San Francisco?
This analysis will focus on the link between elevation and “hilliness” in determining the likelihood of car break-ins in San Francisco. Both terrain and motor vehicle crimes are ubiquitous when discussing living or visiting San Francisco. This relationship has been coined by the phrase - “Crime Doesn’t Climb”.
In April 2021, Young-An Kim & James C. Wo published Topography and crime in place: The effects of elevation, slope, and betweenness in San Francisco street segments. Their study provides a robust regression analysis on the effects of elevation, slope, and “hilliness” on crime, controlling for socio-demographic characteristics Kim and Wo (2021). My analysis will focus only on car break-ins rather than all crime reports, as I believe that these crimes will have an even more pronounced relationship with topography. Their analysis also delved deeper into street connectivity and the city’s road networks as factors of crime occurrence.
In order to collect data, we first need to identify our key variables.
Dependent variable: Crime (specifically car break-ins)
Independent variables: Elevation and slope
Control variables: Median income by census block
When discussing topography, both elevation and “hilliness,” or slope, are necessary for inclusion. This is because it more accurately captures the effect of local level topography, which is supported by Kim & Wo.
In any econometric analysis, it is vital to control for socio-economic variables. In this case, it could be that higher elevations in the city are more affluent areas, which may have an impact on crime. Thus, we want to include median income as a control variable.
Here is the regression equation:
\[MotorVehicleTheft_i = \beta_0 + \beta_1Elevation_i + \beta_2Slope_i + \beta_3MedianIncome_i + u_i\]
Crime and elevation data for this analysis were retrieved from the San Francisco Open Data Portal.
Crime - All crime reports from 2018-01-01 to 2021-11-04.
Elevation contours - 5 ft. elevation contours, which were also used to derive slope. This was achieved through a geo-processing workflow in QGIS (see this video for a walk through of this process).
Median income by census tract was retrieved through the tidycensus package via the US Census Bureau.
The analysis plan steps to address this research question are as follows:
Completed in previous sections*
# EPSG:7132 - NAD83(2011) / San Francisco CS13 (ftUS) - Projected
#crimes <- st_read("data/crime_reports_2018_present/crime_reports_2018_present.shp", query = "SELECT date_incid FROM crime_reports_2018_present WHERE incident_2 = 'Motor Vehicle Theft'") %>%
# st_transform(crs = st_crs(7132))
crimes <- st_read("data/crime_reports_2018_present/motor_vehicle_theft/motor_vehicle_theft_w_slope.shp", query = "SELECT date_incid, slope FROM motor_vehicle_theft_w_slope WHERE slope IS NOT NULL")
Reading query `SELECT date_incid, slope FROM motor_vehicle_theft_w_slope WHERE slope IS NOT NULL' from data source `C:\Users\clipp\Documents\UCSB\Website\alexclippinger.github.io\_posts\2021-11-02-sf-crime-and-hilliness\data\crime_reports_2018_present\motor_vehicle_theft\motor_vehicle_theft_w_slope.shp'
using driver `ESRI Shapefile'
Simple feature collection with 24454 features and 2 fields
Geometry type: POINT
Dimension: XYZ
Bounding box: xmin: 139763.1 ymin: 63441.8 xmax: 181072.3 ymax: 99940.44
z_range: zmin: 0 zmax: 68.33842
Projected CRS: NAD83(2011) / San Francisco CS13 (ftUS)
contours <- st_read("data/contours/contours.shp") %>%
st_transform(crs = st_crs(7132))
Reading layer `contours' from data source
`C:\Users\clipp\Documents\UCSB\Website\alexclippinger.github.io\_posts\2021-11-02-sf-crime-and-hilliness\data\contours\contours.shp'
using driver `ESRI Shapefile'
Simple feature collection with 13901 features and 4 fields
Geometry type: LINESTRING
Dimension: XY
Bounding box: xmin: -122.5177 ymin: 37.69998 xmax: -122.357 ymax: 37.81103
Geodetic CRS: WGS84(DD)
# developments on parcels with slopes of 20%+. Need to buffer to include streets
#slopes_over_20 <- st_read("data/slopes_over_20/buffered_slope_areas.shp", query = "SELECT objectid as slope_over_20 FROM buffered_slope_areas") %>%
# st_transform(crs = st_crs(7132))
# need to run census_api_key() first
census_geom <- get_acs(geography = 'tract',
variables = "B19013_001",
state = "CA",
county = "San Francisco",
geometry = TRUE) %>%
st_transform(crs = st_crs(7132))
|
| | 0%
|
|= | 1%
|
|= | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 6%
|
|==== | 7%
|
|===== | 8%
|
|===== | 9%
|
|====== | 9%
|
|====== | 10%
|
|====== | 11%
|
|======= | 11%
|
|======= | 12%
|
|======== | 13%
|
|======== | 14%
|
|========= | 14%
|
|========= | 15%
|
|========= | 16%
|
|========== | 16%
|
|========== | 17%
|
|=========== | 18%
|
|=========== | 19%
|
|============ | 19%
|
|============ | 20%
|
|============= | 21%
|
|============= | 22%
|
|============== | 23%
|
|============== | 24%
|
|=============== | 24%
|
|=============== | 25%
|
|================ | 26%
|
|================ | 27%
|
|================= | 28%
|
|================= | 29%
|
|================== | 29%
|
|================== | 30%
|
|=================== | 31%
|
|=================== | 32%
|
|==================== | 33%
|
|==================== | 34%
|
|===================== | 34%
|
|===================== | 35%
|
|===================== | 36%
|
|====================== | 36%
|
|====================== | 37%
|
|======================= | 38%
|
|======================= | 39%
|
|======================== | 39%
|
|======================== | 40%
|
|========================= | 41%
|
|========================= | 42%
|
|========================== | 43%
|
|========================== | 44%
|
|=========================== | 44%
|
|=========================== | 45%
|
|============================ | 46%
|
|============================ | 47%
|
|============================= | 48%
|
|============================= | 49%
|
|============================== | 49%
|
|============================== | 50%
|
|============================== | 51%
|
|=============================== | 51%
|
|=============================== | 52%
|
|================================ | 53%
|
|================================= | 54%
|
|================================= | 55%
|
|================================== | 56%
|
|================================== | 57%
|
|=================================== | 58%
|
|=================================== | 59%
|
|==================================== | 59%
|
|==================================== | 60%
|
|===================================== | 61%
|
|===================================== | 62%
|
|====================================== | 63%
|
|====================================== | 64%
|
|======================================= | 64%
|
|======================================= | 65%
|
|======================================== | 66%
|
|======================================== | 67%
|
|========================================= | 68%
|
|========================================= | 69%
|
|========================================== | 69%
|
|========================================== | 70%
|
|=========================================== | 71%
|
|=========================================== | 72%
|
|============================================ | 73%
|
|============================================ | 74%
|
|============================================= | 74%
|
|============================================= | 75%
|
|============================================= | 76%
|
|============================================== | 76%
|
|============================================== | 77%
|
|=============================================== | 78%
|
|================================================ | 79%
|
|================================================ | 80%
|
|================================================ | 81%
|
|================================================= | 81%
|
|================================================= | 82%
|
|================================================== | 83%
|
|================================================== | 84%
|
|=================================================== | 84%
|
|=================================================== | 85%
|
|==================================================== | 86%
|
|==================================================== | 87%
|
|===================================================== | 88%
|
|===================================================== | 89%
|
|====================================================== | 89%
|
|====================================================== | 90%
|
|======================================================= | 91%
|
|======================================================= | 92%
|
|======================================================== | 93%
|
|======================================================== | 94%
|
|========================================================= | 94%
|
|========================================================= | 95%
|
|========================================================= | 96%
|
|========================================================== | 96%
|
|========================================================== | 97%
|
|=========================================================== | 98%
|
|=========================================================== | 99%
|
|============================================================| 99%
|
|============================================================| 100%
The following code chunk demonstrates how the crime, elevation, slope, and income datasets were merged.
# Find index of nearest contour to each crime
elev <- st_nearest_feature(x = crimes, y = contours)
# Add elevation and binary slope columns
crimes <- crimes %>%
st_join(y = census_geom, join = st_within, left = TRUE) %>%
mutate(elev = contours[elev,]$elevation) %>%
rename(median_income = estimate) %>%
select(date_incid, slope, median_income, elev, geometry)
The following plots show the simple relationships between count of car break ins and the three independent variables (elevation, slope, and median income).
# Group by income only
income_summary <- crimes %>%
st_drop_geometry() %>%
group_by(median_income) %>%
summarize(count = n())
income_plot = ggplot(data = income_summary, aes(x = median_income, y = count)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
theme_classic() +
labs(title = "Crime and Median Income",
x = "Median Income (USD)",
y = "Number of Break-Ins")
# Group by elevation
elev_summary <- crimes %>%
st_drop_geometry() %>%
group_by(elev) %>%
summarize(count = n())
elev_plot <- ggplot(data = elev_summary, aes(x = elev, y = count)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
theme_classic() +
labs(title = "Crime and Elevation",
x = "Elevation (feet)",
y = "Number of Break-Ins")
# Group by slope
slope_summary <- crimes %>%
st_drop_geometry() %>%
group_by(slope) %>%
summarize(count = n())
slope_plot <- ggplot(data = slope_summary, aes(x = slope, y = count)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
theme_classic() +
labs(title = "Crime and Slope",
x = "Slope (percent)",
y = "Number of Break-Ins")
elev_plot + (slope_plot / income_plot)

We see there is a negative correlation between elevation and crime. It is possible that this relationship is not linear, so this variable may fit better if we take the natural log. Since slope in this analysis is a binary variable, we simply see that there are more crimes in areas that are not designated high slope. Lastly, we observe a weak negative correlation between median income and car break-ins.
The following plots show crimes over the time period of our data.
# Group by all three variables
crimes_summary <- crimes %>%
st_drop_geometry() %>%
group_by(slope, median_income, elev) %>%
summarize(count = n())
# Group by date
crimes_ts <- crimes %>%
st_drop_geometry() %>%
group_by(date_incid) %>%
summarize(count = n())
ts_plot <- ggplot(data = crimes_ts, aes(x = date_incid, y = count)) +
geom_point() +
geom_smooth(method = "lm") +
theme_classic() +
labs(title = "Daily Crime 2018-Present",
x = "Date (daily)",
y = "Number of Break-Ins")
crimes_monthly <- crimes_ts %>%
mutate(month = lubridate::floor_date(date_incid, "month")) %>%
group_by(month) %>%
summarize(monthly_sum = sum(count)) %>%
filter(month != "2021-11-01")
monthly_plot <- ggplot(data = crimes_monthly, aes(x = month, y = monthly_sum)) +
geom_point() +
geom_line() +
#geom_smooth(method = "lm") +
theme_classic() +
labs(title = "Monthly Crime 2018-Present",
x = "Date (monthly)",
y = "Number of Break-Ins")
ts_plot + monthly_plot

We can see that there is an upward trend to our crime data over the time period of our data.